home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_bas / svgapv24.zip / SVGAMOD2.BAS < prev    next >
BASIC Source File  |  1996-01-30  |  44KB  |  1,247 lines
  1. '****************************************************************************
  2. '*
  3. '*      'SVGAQB' & 'SVGAPV' A Super VGA Graphics Librarys for use with
  4. '*      MS QuickBASIC 4.X and MS PDS/VBDOS
  5. '*      Copyright 1993-1996 by Stephen L. Balkum and Daniel A. Sill
  6. '*
  7. '*      MS, QuickBASIC, PDS, and VBDOS are registered trademarks of
  8. '*      Microsoft Corporation.
  9. '*
  10. '*    **************** UNREGISTERED SHAREWARE VERSION **********************
  11. '*    * FOR EVALUATION ONLY. NOT FOR RESALE IN ANY FORM. SOFTWARE WRITTEN  *
  12. '*    * USING THIS UNREGISTERED SHAREWARE GRAPHICS LIBRARY MAY NOT BY SOLD *
  13. '*    * OR USED FOR ANY PURPOSE OTHER THAN THE EVALUATION OF THIS LIBRARY. *
  14. '*    **********************************************************************
  15. '*
  16. '*    **************** NO WARRANTIES AND NO LIABILITY **********************
  17. '*    * Stephen L. Balkum and Daniel A. Sill provide no warranties, either *
  18. '*    * expressed or implied, of merchant ability, or fitness, for a       *
  19. '*    * particular use or purpose of this SOFTWARE and documentation.      *
  20. '*    * In no event shall Stephen L. Balkum or Daniel A. Sill be held      *
  21. '*    * liable for any damages resulting from the use or misuse of the     *
  22. '*    * SOFTWARE and documentation.                                        *
  23. '*    **********************************************************************
  24. '*
  25. '*    ************** U.S. GOVERNMENT RESTRICTED RIGHTS *********************
  26. '*    * Use, duplication, or disclosure of the SOFTWARE and documentation  *
  27. '*    * by the U.S. Government is subject to the restrictions as set forth *
  28. '*    * in subparagraph (c)(1)(ii) of the Rights in Technical Data and     *
  29. '*    * Computer Software clause at DFARS 252.227-7013.                    *
  30. '*    * Contractor/manufacturer is Stephen L. Balkum and Daniel A. Sill,   *
  31. '*    * P.O. Box 7704, Austin, Texas 78713-7704                            *
  32. '*    **********************************************************************
  33. '*
  34. '*    **********************************************************************
  35. '*    * By using this SOFTWARE or documentation, you agree to the above    *
  36. '*    * terms and conditions.                                              *
  37. '*    **********************************************************************
  38. '*
  39. '****************************************************************************
  40.  
  41.  
  42.     REM $INCLUDE: 'SVGABC.BI'
  43.     REM $INCLUDE: 'SVGADEMO.BI'
  44.     REM $DYNAMIC
  45.     DEFINT A-Z
  46.  
  47.     SUB DO2D (RET$)
  48.     DEFINT A-Z
  49.     REM $DYNAMIC
  50.  
  51.     DIM POINTARRY(0 TO 8) AS P2DType
  52.  
  53.     '*************************************************************************
  54.     '* SET UP THE TITLE
  55.     '*************************************************************************
  56.     TITLE$ = "DEMO 11: 2D functions"
  57.     PALSET PAL, 0, 255
  58.  
  59.     '*************************************************************************
  60.     '* SET UP THE 'STAR' PATTERN OF POINTS
  61.     '*************************************************************************
  62.     SETVIEW 0, 0, GETMAXX, GETMAXY
  63.     CNTX = GETMAXX \ 2
  64.     CNTY = ((GETMAXY - 32) \ 2) + 32
  65.     SPCNG = GETMAXX \ 30
  66.     POINTARRY(0).X = 0
  67.     POINTARRY(0).Y = -SPCNG * 6
  68.     POINTARRY(1).X = SPCNG * 2
  69.     POINTARRY(1).Y = -SPCNG * 2
  70.     POINTARRY(2).X = SPCNG * 6
  71.     POINTARRY(2).Y = 0
  72.     POINTARRY(3).X = SPCNG * 2
  73.     POINTARRY(3).Y = SPCNG * 2
  74.     POINTARRY(4).X = 0
  75.     POINTARRY(4).Y = SPCNG * 6
  76.     POINTARRY(5).X = -SPCNG * 2
  77.     POINTARRY(5).Y = SPCNG * 2
  78.     POINTARRY(6).X = -SPCNG * 6
  79.     POINTARRY(6).Y = 0
  80.     POINTARRY(7).X = -SPCNG * 2
  81.     POINTARRY(7).Y = -SPCNG * 2
  82.     POINTARRY(8).X = 0
  83.     POINTARRY(8).Y = -SPCNG * 6
  84.  
  85.     '*************************************************************************
  86.     '* SHOW D2TRANSLATE
  87.     '*************************************************************************
  88.     FILLSCREEN 0
  89.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  90.     A$ = "D2TRANSLATE (Points,XTrans,YTrans,InAry,OutAry)"
  91.     DRWSTRING 1, 7, 0, A$, 10, 16
  92.     SETVIEW 0, 32, GETMAXX, GETMAXY
  93.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  94.     SHOWSTAR
  95.     GETKEY RET$
  96.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  97.         FILLSCREEN 0
  98.         SETVIEW 0, 0, GETMAXX, GETMAXY
  99.         EXIT SUB
  100.     END IF
  101.     XTRANS = 0
  102.     YTRANS = 0
  103.     FOR J = 0 TO SPCNG * 2
  104.         XTRANS = XTRANS + 2
  105.         YTRANS = YTRANS + 2
  106.         D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
  107.         SHOWSTAR
  108.         SDELAY 2
  109.     NEXT J
  110.     FOR J = 0 TO SPCNG * 2
  111.         XTRANS = XTRANS - 2
  112.         YTRANS = YTRANS - 2
  113.         D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
  114.         SHOWSTAR
  115.         SDELAY 2
  116.     NEXT J
  117.     GETKEY RET$
  118.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  119.         FILLSCREEN 0
  120.         SETVIEW 0, 0, GETMAXX, GETMAXY
  121.         EXIT SUB
  122.     END IF
  123.  
  124.     '*************************************************************************
  125.     '* SHOW D2SCALE
  126.     '*************************************************************************
  127.     SETVIEW 0, 0, GETMAXX, 31
  128.     FILLVIEW 0
  129.     SETVIEW 0, 0, GETMAXX, GETMAXY
  130.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  131.     A$ = "D2SCALE (Points,XScale,YScale,InAry,OutAry)"
  132.     DRWSTRING 1, 7, 0, A$, 10, 16
  133.     SETVIEW 0, 32, GETMAXX, GETMAXY
  134.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  135.     SHOWSTAR
  136.     FOR J = 256 TO 380 STEP 4
  137.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  138.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  139.         SHOWSTAR
  140.         SDELAY 2
  141.         NEXT J
  142.     X = J
  143.     FOR J = X TO 256 STEP -4
  144.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  145.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  146.         SHOWSTAR
  147.         SDELAY 2
  148.     NEXT J
  149.     X = J
  150.     FOR J = X TO 128 STEP -4
  151.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  152.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  153.         SHOWSTAR
  154.         SDELAY 2
  155.     NEXT J
  156.     X = J
  157.     FOR J = X TO 256 STEP 4
  158.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  159.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  160.         SHOWSTAR
  161.         SDELAY 2
  162.     NEXT J
  163.     GETKEY RET$
  164.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  165.         FILLSCREEN 0
  166.         SETVIEW 0, 0, GETMAXX, GETMAXY
  167.         EXIT SUB
  168.     END IF
  169.  
  170.     '*************************************************************************
  171.     '* SHOW D2ROTATE (ABOUT THE CENTER OF THE OBJECT)
  172.     '*************************************************************************
  173.     SETVIEW 0, 0, GETMAXX, 31
  174.     FILLVIEW 0
  175.     SETVIEW 0, 0, GETMAXX, GETMAXY
  176.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  177.     A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
  178.     DRWSTRING 1, 7, 0, A$, 10, 16
  179.     A$ = "Lets do it about the center of the object."
  180.     DRWSTRING 1, 7, 0, A$, 10, 32
  181.     SETVIEW 0, 32, GETMAXX, GETMAXY
  182.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  183.     SHOWSTAR
  184.     FOR J = 0 TO 180
  185.         D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
  186.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  187.         SHOWSTAR
  188.         SDELAY 2
  189.     NEXT J
  190.     FOR J = 180 TO 0 STEP -2
  191.         D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
  192.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  193.         SHOWSTAR
  194.         SDELAY 2
  195.     NEXT J
  196.     GETKEY RET$
  197.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  198.         FILLSCREEN 0
  199.         SETVIEW 0, 0, GETMAXX, GETMAXY
  200.         EXIT SUB
  201.     END IF
  202.  
  203.     '*************************************************************************
  204.     '* SHOW D2ROTATE (ABOUT AN ARBITRARY POINT)
  205.     '*************************************************************************
  206.     SETVIEW 0, 0, GETMAXX, 48
  207.     FILLVIEW 0
  208.     SETVIEW 0, 0, GETMAXX, GETMAXY
  209.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  210.     A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
  211.     DRWSTRING 1, 7, 0, A$, 10, 16
  212.     A$ = "Lets do it about an arbitrary point."
  213.     DRWSTRING 1, 7, 0, A$, 10, 32
  214.     SETVIEW 0, 32, GETMAXX, GETMAXY
  215.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  216.     SHOWSTAR
  217.     FOR J = 0 TO 360 STEP 2
  218.         D2ROTATE 9, 0, SPCNG * 6, J, POINTARRY(0).X, PLOTARRY(0).X
  219.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  220.         SHOWSTAR
  221.         SDELAY 2
  222.     NEXT J
  223.     SETVIEW 0, 0, GETMAXX, GETMAXY
  224.     GETKEY RET$
  225.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  226.         FILLSCREEN 0
  227.         EXIT SUB
  228.     END IF
  229.  
  230.     END SUB
  231.  
  232.     SUB DO3D (RET$)
  233.     DEFINT A-Z
  234.     REM $DYNAMIC
  235.  
  236.     '*************************************************************************
  237.     '* SET UP THE TITLE
  238.     '*************************************************************************
  239.     TITLE$ = "DEMO 12: 3D functions"
  240.     PALSET PAL, 0, 255
  241.  
  242.     '*************************************************************************
  243.     '* SET UP THE 'HOUSE' PATTERN OF POINTS
  244.     '*************************************************************************
  245.     SETVIEW 0, 0, GETMAXX, GETMAXY
  246.     CNTX = GETMAXX \ 2
  247.     CNTY = ((GETMAXY - 32) \ 2) + 32
  248.     CNTZ = 0
  249.     SPCNG = GETMAXX \ 6
  250.     POINTARRY3D(0).X = -SPCNG
  251.     POINTARRY3D(0).Y = -SPCNG * 2
  252.     POINTARRY3D(0).Z = 0
  253.     POINTARRY3D(1).X = SPCNG
  254.     POINTARRY3D(1).Y = -SPCNG * 2
  255.     POINTARRY3D(1).Z = 0
  256.     POINTARRY3D(2).X = SPCNG
  257.     POINTARRY3D(2).Y = -SPCNG * 2
  258.     POINTARRY3D(2).Z = SPCNG * 2
  259.     POINTARRY3D(3).X = -SPCNG
  260.     POINTARRY3D(3).Y = -SPCNG * 2
  261.     POINTARRY3D(3).Z = SPCNG * 2
  262.     POINTARRY3D(4).X = -SPCNG
  263.     POINTARRY3D(4).Y = SPCNG * 2
  264.     POINTARRY3D(4).Z = 0
  265.     POINTARRY3D(5).X = SPCNG
  266.     POINTARRY3D(5).Y = SPCNG * 2
  267.     POINTARRY3D(5).Z = 0
  268.     POINTARRY3D(6).X = SPCNG
  269.     POINTARRY3D(6).Y = SPCNG * 2
  270.     POINTARRY3D(6).Z = SPCNG * 2
  271.     POINTARRY3D(7).X = -SPCNG
  272.     POINTARRY3D(7).Y = SPCNG * 2
  273.     POINTARRY3D(7).Z = SPCNG * 2
  274.     POINTARRY3D(8).X = 0
  275.     POINTARRY3D(8).Y = -SPCNG * 2
  276.     POINTARRY3D(8).Z = SPCNG * 3
  277.     POINTARRY3D(9).X = 0
  278.     POINTARRY3D(9).Y = SPCNG * 2
  279.     POINTARRY3D(9).Z = SPCNG * 3
  280.     POINTARRY3D(10).X = 0
  281.     POINTARRY3D(10).Z = 0
  282.     POINTARRY3D(10).Y = 0
  283.     POINTARRY3D(11).X = SPCNG * 4
  284.     POINTARRY3D(11).Z = 0
  285.     POINTARRY3D(11).Y = 0
  286.     POINTARRY3D(12).X = 0
  287.     POINTARRY3D(12).Z = 0
  288.     POINTARRY3D(12).Y = SPCNG * 4
  289.     POINTARRY3D(13).X = 0
  290.     POINTARRY3D(13).Z = SPCNG * 4
  291.     POINTARRY3D(13).Y = 0
  292.  
  293.     '*************************************************************************
  294.     '* SHOW D3PROJECT
  295.     '*************************************************************************
  296.     PI! = 4 * ATN(1) / 180
  297.     FILLSCREEN 0
  298.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  299.     A$ = "D3PROJECT (Points,ProjParams,InAry,OutAry)"
  300.     DRWSTRING 1, 7, 0, A$, 10, 16
  301.     SETVIEW 0, 32, GETMAXX, GETMAXY
  302.     HEIGHT = GETMAXY * 8
  303.     Radius = GETMAXX * 30
  304.     J = 110
  305.     PROJ.EYEX = FIX(-Radius * COS(J * PI!))
  306.     PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
  307.     PROJ.EYEZ = HEIGHT
  308.     PROJ.SCRD = ((Radius ^ 2 + HEIGHT ^ 2) ^ .5) \ 2
  309.     PROJ.THETA = J
  310.     PROJ.PHI = CINT(ATN(HEIGHT / -Radius) / PI!)
  311.     BYTECOPY POINTARRY3D(0).X, PLAYARRY(0).X, 84
  312.     R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  313.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
  314.     SHOWHOUSE
  315.     GETKEY RET$
  316.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  317.         FILLSCREEN 0
  318.         SETVIEW 0, 0, GETMAXX, GETMAXY
  319.         EXIT SUB
  320.     END IF
  321.     FOR J = 112 TO 470 STEP 3
  322.         PROJ.EYEX = FIX(-Radius * COS(J * PI!))
  323.         PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
  324.         PROJ.THETA = J
  325.         R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  326.         SHOWHOUSE
  327.         SDELAY 2
  328.     NEXT J
  329.     GETKEY RET$
  330.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  331.         FILLSCREEN 0
  332.         SETVIEW 0, 0, GETMAXX, GETMAXY
  333.         EXIT SUB
  334.     END IF
  335.  
  336.     '*************************************************************************
  337.     '* SHOW D3TRANSLATE
  338.     '*************************************************************************
  339.     SETVIEW 0, 0, GETMAXX, 31
  340.     FILLVIEW 0
  341.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  342.     A$ = "D3TRANSLATE (Points,XTrans,YTrans,ZTrans,InAry,OutAry)"
  343.     DRWSTRING 1, 7, 0, A$, 10, 16
  344.     SETVIEW 0, 32, GETMAXX, GETMAXY
  345.     FOR J = 2 TO 300 STEP 6
  346.         D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
  347.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  348.         SHOWHOUSE
  349.         SDELAY 2
  350.     NEXT J
  351.     X = J
  352.     FOR J = X TO 2 STEP -6
  353.         D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
  354.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  355.         SHOWHOUSE
  356.         SDELAY 2
  357.     NEXT J
  358.     GETKEY RET$
  359.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  360.         FILLSCREEN 0
  361.         SETVIEW 0, 0, GETMAXX, GETMAXY
  362.         EXIT SUB
  363.     END IF
  364.  
  365.     '*************************************************************************
  366.     '* SHOW D3SCALE
  367.     '*************************************************************************
  368.     SETVIEW 0, 0, GETMAXX, 31
  369.     FILLVIEW 0
  370.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  371.     A$ = "D3SCALE (Points,XScale,YScale,ZScale,InAry,OutAry)"
  372.     DRWSTRING 1, 7, 0, A$, 10, 16
  373.     SETVIEW 0, 32, GETMAXX, GETMAXY
  374.     FOR J = 256 TO 380 STEP 4
  375.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  376.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  377.         SHOWHOUSE
  378.         SDELAY 2
  379.         NEXT J
  380.     X = J
  381.     FOR J = X TO 256 STEP -4
  382.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  383.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  384.         SHOWHOUSE
  385.         SDELAY 2
  386.     NEXT J
  387.     X = J
  388.     FOR J = X TO 128 STEP -4
  389.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  390.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  391.         SHOWHOUSE
  392.         SDELAY 2
  393.     NEXT J
  394.     X = J
  395.     FOR J = X TO 256 STEP 4
  396.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  397.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  398.         SHOWHOUSE
  399.         SDELAY 2
  400.     NEXT J
  401.     GETKEY RET$
  402.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  403.         FILLSCREEN 0
  404.         SETVIEW 0, 0, GETMAXX, GETMAXY
  405.         EXIT SUB
  406.     END IF
  407.  
  408.     '*************************************************************************
  409.     '* SHOW D2ROTATE (ABOUT THE ORIGIN)
  410.     '*************************************************************************
  411.     SETVIEW 0, 0, GETMAXX, 31
  412.     FILLVIEW 0
  413.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  414.     A$ = "D3ROTATE (Points,XOrigin,YOrigin,ZOrigin,ZAngle,YAngle,XAngle,InAry,OutAry) "
  415.     DRWSTRING 1, 7, 0, A$, 10, 16
  416.     A$ = "Lets do it about the origin."
  417.     DRWSTRING 1, 7, 0, A$, 10, 32
  418.     SETVIEW 0, 32, GETMAXX, GETMAXY
  419.     FOR J = 0 TO 360 STEP 3
  420.         D3ROTATE 10, 0, 0, 0, 0, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  421.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  422.         SHOWHOUSE
  423.         SDELAY 2
  424.     NEXT J
  425.     GETKEY RET$
  426.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  427.         FILLSCREEN 0
  428.         SETVIEW 0, 0, GETMAXX, GETMAXY
  429.         EXIT SUB
  430.     END IF
  431.  
  432.  
  433.  
  434.     END SUB
  435.  
  436.     SUB DOJOYSTICK (RET$)
  437.     DEFINT A-Z
  438.     REM $DYNAMIC
  439.  
  440.     '*************************************************************************
  441.     '* SET UP THE TITLE
  442.     '*************************************************************************
  443.     TITLE$ = "DEMO 10: Joystick functions"
  444.     PALSET PAL, 0, 255
  445.     FILLSCREEN 0
  446.     SETVIEW 0, 0, GETMAXX, GETMAXY
  447.  
  448.     '*************************************************************************
  449.     '* CHECK TO SEE IF WE HAVE A JOYSTICK SO WE CAN DO THE JOYSTICK DEMO
  450.     '*************************************************************************
  451.     JOYSTICK = WHICHJOYSTICK
  452.     IF JOYSTICK < 1 THEN
  453.         SOUND 100, 5
  454.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  455.         A$ = "Sorry, No Joystick Detected..."
  456.         DRWSTRING 1, 7, 0, A$, 10, 16
  457.         A$ = "Can Not Do The Joystick Demo."
  458.         DRWSTRING 1, 7, 0, A$, 10, 32
  459.         A$ = "Press A Key..."
  460.         DRWSTRING 1, 15, 0, A$, 10, 48
  461.         WHILE INKEY$ = ""
  462.         WEND
  463.         FILLSCREEN 0
  464.         EXIT SUB
  465.     END IF
  466.  
  467.     '*************************************************************************
  468.     '* SHOW JOYSTICKINFO (HERE WE DO SOME JOYSTICK CALIBRATION)
  469.     '*************************************************************************
  470.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  471.     A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
  472.     DRWSTRING 1, 7, 0, A$, 10, 16
  473.     SETVIEW 0, 0, GETMAXX, GETMAXY
  474.     SELECT CASE JOYSTICK
  475.         CASE IS = 1
  476.             A$ = "Please Move Joystick A As Far As It Will Go In All Directions"
  477.         CASE IS = 2
  478.             A$ = "Please Move Joystick B As Far As It Will Go In All Directions"
  479.         CASE IS = 3
  480.             A$ = "Please Move Both Joystick A And B As Far As They Will Go In All Directions"
  481.     END SELECT
  482.     DRWSTRING 1, 7, 0, A$, 10, 32
  483.     A$ = "And Then Press A Key..."
  484.     DRWSTRING 1, 7, 0, A$, 10, 48
  485.     SOUND 700, .75
  486.     GETMAXXA = -1
  487.     MAXYA = -1
  488.     MINXA = 10000
  489.     MINYA = 10000
  490.     GETMAXXB = -1
  491.     MAXYB = -1
  492.     MINXB = 10000
  493.     MINYB = 10000
  494.     A$ = ""
  495.     WHILE A$ = ""
  496.         JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
  497.         IF JAX > GETMAXXA THEN
  498.             GETMAXXA = JAX
  499.         END IF
  500.         IF JAX < MINXA THEN
  501.             MINXA = JAX
  502.         END IF
  503.         IF JAY > MAXYA THEN
  504.             MAXYA = JAY
  505.         END IF
  506.         IF JAY < MINYA THEN
  507.             MINYA = JAY
  508.         END IF
  509.         IF JBX > GETMAXXB THEN
  510.             GETMAXXB = JBX
  511.         END IF
  512.         IF JBX < MINXB THEN
  513.             MINXB = JBX
  514.         END IF
  515.         IF JBY > MAXYB THEN
  516.             MAXYB = JBY
  517.         END IF
  518.         IF JBY < MINYB THEN
  519.             MINYB = JBY
  520.         END IF
  521.         A$ = INKEY$
  522.     WEND
  523.  
  524.     '*************************************************************************
  525.     '* CALCULATE THE CENTER AND STUFF...
  526.     '*************************************************************************
  527.     SPCNG = GETMAXX \ 7
  528.     DIST = SPCNG * 2
  529.     X1 = SPCNG \ 2
  530.     Y1 = SPCNG \ 2 + 32
  531.     X2 = X1 + DIST
  532.     Y2 = Y1 + DIST
  533.     X4 = GETMAXX - SPCNG
  534.     Y4 = Y2
  535.     X3 = X4 - DIST
  536.     Y3 = Y1
  537.     CNTAX = (X2 - X1) / 2 + X1
  538.     CNTAY = (Y2 - Y1) / 2 + Y1
  539.     CNTBX = (X4 - X3) / 2 + X3
  540.     CNTBY = (Y4 - Y3) / 2 + Y3
  541.     RANGEXA = GETMAXXA - MINXA
  542.     RANGEYA = MAXYA - MINYA
  543.     RANGEXB = GETMAXXB - MINXB
  544.     RANGEYB = MAXYB - MINYB
  545.     JABAX = (X2 - X1) \ 4 + X1 - 16
  546.     JABAY = (SPCNG \ 4) + Y2 - 6
  547.     JABBX = X2 - (X2 - X1) \ 4 - 16
  548.     JABBY = (SPCNG \ 4) + Y2 - 6
  549.     JBBAX = (X4 - X3) \ 4 + X3 - 16
  550.     JBBAY = (SPCNG \ 4) + Y4 - 6
  551.     JBBBX = X4 - (X4 - X3) \ 4 - 16
  552.     JBBBY = (SPCNG \ 4) + Y4 - 6
  553.  
  554.     '*************************************************************************
  555.     '* LETS MOVE IT (OR THEM) AROUND
  556.     '*************************************************************************
  557.     SETVIEW 0, 0, GETMAXX, 64
  558.     FILLVIEW 0
  559.     SETVIEW 0, 0, GETMAXX, GETMAXY
  560.     IF JOYSTICK AND 1 THEN
  561.         DRWBOX 1, 15, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
  562.         DRWBOX 1, 15, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
  563.         DRWLINE 1, 15, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
  564.         OAX = CNTAX
  565.         OAY = CNTAY
  566.         DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
  567.     ELSE
  568.         DRWBOX 1, 8, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
  569.         DRWBOX 1, 8, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
  570.         DRWLINE 1, 8, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
  571.     END IF
  572.     IF JOYSTICK AND 2 THEN
  573.         DRWBOX 1, 15, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
  574.         DRWBOX 1, 15, X3 - 1, Y4 + 1, X4 + 1, Y4 + SPCNG \ 2
  575.         DRWLINE 1, 15, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
  576.         OBX = CNTBX
  577.         OBY = CNTBY
  578.         DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
  579.     ELSE
  580.         DRWBOX 1, 8, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
  581.         DRWBOX 1, 8, X3 - 1, Y3 + 1, X4 + 1, Y4 + SPCNG \ 2
  582.         DRWLINE 1, 8, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
  583.     END IF
  584.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  585.     A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
  586.     DRWSTRING 1, 7, 0, A$, 10, 16
  587.     SETVIEW 0, 32, GETMAXX, GETMAXY
  588.     A$ = ""
  589.     WHILE A$ = ""
  590.         JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
  591.         IF JOYSTICK AND 1 THEN
  592.             SETVIEW X1, Y1, X2, Y2
  593.             JAX = JAX - MINXA
  594.             JAX = JAX / RANGEXA * DIST + X1
  595.             JAY = JAY - MINYA
  596.             JAY = JAY / RANGEYA * DIST + Y1
  597.             DRWLINE 1, 0, CNTAX, CNTAY, OAX, OAY
  598.             OAX = JAX
  599.             OAY = JAY
  600.             DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
  601.             SETVIEW 0, 0, GETMAXX, GETMAXY
  602.             IF JAButs AND 1 THEN
  603.                 DRWSTRING 1, 10, 0, "ButA", JABAX, JABAY
  604.             ELSE
  605.                 DRWSTRING 1, 8, 0, "ButA", JABAX, JABAY
  606.             END IF
  607.             IF JAButs AND 2 THEN
  608.                 DRWSTRING 1, 10, 0, "ButB", JABBX, JABBY
  609.             ELSE
  610.                 DRWSTRING 1, 8, 0, "ButB", JABBX, JABBY
  611.             END IF
  612.         END IF
  613.         IF JOYSTICK AND 2 THEN
  614.             SETVIEW X3, Y3, X4, Y4
  615.             JBX = JBX - MINXB
  616.             JBX = JBX / RANGEXB * DIST + X3
  617.             JBY = JBY - MINYB
  618.             JBY = JBY / RANGEYB * DIST + Y3
  619.             DRWLINE 1, 0, CNTBX, CNTBY, OBX, OBY
  620.             OBX = JBX
  621.             OBY = JBY
  622.             DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
  623.             SETVIEW 0, 0, GETMAXX, GETMAXY
  624.             IF JBButs AND 1 THEN
  625.                 DRWSTRING 1, 10, 0, "ButA", JBBAX, JBBAY
  626.             ELSE
  627.                 DRWSTRING 1, 8, 0, "ButA", JBBAX, JBBAY
  628.             END IF
  629.             IF JBButs AND 2 THEN
  630.                 DRWSTRING 1, 10, 0, "ButB", JBBBX, JBBBY
  631.             ELSE
  632.                 DRWSTRING 1, 8, 0, "ButB", JBBBX, JBBBY
  633.             END IF
  634.         END IF
  635.         A$ = INKEY$
  636.     WEND
  637.     RET$ = A$
  638.     IF RET$ = "q" THEN
  639.         RET$ = "Q"
  640.     END IF
  641.     IF RET$ = "s" THEN
  642.         RET$ = "S"
  643.     END IF
  644.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  645.         FILLSCREEN 0
  646.         SETVIEW 0, 0, GETMAXX, GETMAXY
  647.         EXIT SUB
  648.     END IF
  649.  
  650.     SETVIEW 0, 0, GETMAXX, GETMAXY
  651.  
  652.     END SUB
  653.  
  654.     SUB DOMOUSE (RET$)
  655.     DEFINT A-Z
  656.     REM $DYNAMIC
  657.  
  658.     '*************************************************************************
  659.     '* SET UP THE TITLE
  660.     '*************************************************************************
  661.     TITLE$ = "DEMO 9: Mouse functions"
  662.     FILLSCREEN 0
  663.     PALSET PAL, 0, 255
  664.     SETVIEW 0, 0, GETMAXX, GETMAXY
  665.  
  666.     '*************************************************************************
  667.     '* CHECK TO SEE IF WE HAVE A MOUSE SO WE CAN DO THE MOUSE DEMO
  668.     '*************************************************************************
  669.     MOUSE = WHICHMOUSE
  670.     IF MOUSE < 1 THEN
  671.         SOUND 100, 5
  672.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  673.         A$ = "Sorry, No Mouse Detected..."
  674.         DRWSTRING 1, 7, 0, A$, 10, 16
  675.         A$ = "Can Not Do The Mouse Demo."
  676.         DRWSTRING 1, 7, 0, A$, 10, 32
  677.         A$ = "Press A Key..."
  678.         DRWSTRING 1, 15, 0, A$, 10, 48
  679.  
  680.         WHILE INKEY$ = ""
  681.         WEND
  682.         FILLSCREEN 0
  683.         EXIT SUB
  684.     ELSE
  685.         Colr = 16
  686.         FOR I = 0 TO GETMAXX \ 2
  687.             DRWCIRCLE 1, Colr, GETMAXX \ 4 + I, GETMAXY \ 2, GETMAXY \ 5
  688.             Colr = Colr + 2
  689.             IF Colr > 255 THEN
  690.                 Colr = 16
  691.             END IF
  692.         NEXT I
  693.     END IF
  694.  
  695.     '*************************************************************************
  696.     '* SHOW MOUSESHOW
  697.     '*************************************************************************
  698.     SETVIEW 0, 0, GETMAXX, 31
  699.     FILLVIEW 0
  700.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  701.     A$ = "MOUSESHOW ()"
  702.     DRWSTRING 1, 7, 0, A$, 10, 16
  703.     SETVIEW 0, 32, GETMAXX, GETMAXY
  704.     MOUSEENTER '*MUST BE CALLED FIRST TO ENABLE MOUSE FUNCTIONS
  705.     MOUSESHOW
  706.     GETKEY RET$
  707.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  708.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  709.         FILLSCREEN 0
  710.         SETVIEW 0, 0, GETMAXX, GETMAXY
  711.         EXIT SUB
  712.     END IF
  713.  
  714.     '*************************************************************************
  715.     '* SHOW MOUSESTATUS
  716.     '*************************************************************************
  717.     MOUSEHIDE
  718.     SETVIEW 0, 0, GETMAXX, 31
  719.     FILLVIEW 0
  720.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  721.     A$ = "MOUSESTATUS (Xloc,Yloc,MButs)"
  722.     DRWSTRING 1, 7, 0, A$, 10, 16
  723.     MOUSESHOW
  724.     SETVIEW 0, 32, GETMAXX, GETMAXY
  725.     A$ = ""
  726.     SOUND 700, .75
  727.     WHILE A$ = ""
  728.         MOUSESTATUS X, Y, MButs
  729.         IF MButs AND 1 THEN
  730.             LB = 1
  731.         ELSE
  732.             LB = 0
  733.         END IF
  734.         IF MButs AND 2 THEN
  735.             RB = 1
  736.         ELSE
  737.             RB = 0
  738.         END IF
  739.         IF MButs AND 4 THEN
  740.             CB = 1
  741.         ELSE
  742.             CB = 0
  743.         END IF
  744.         D$ = "X=" + STR$(X)
  745.         L = LEN(D$)
  746.         IF L < 10 THEN
  747.             D$ = D$ + STRING$(8 - L, 32)
  748.         END IF
  749.         D$ = D$ + "Y=" + STR$(Y)
  750.         L = LEN(D$)
  751.         IF L < 20 THEN
  752.             D$ = D$ + STRING$(16 - L, 32)
  753.         END IF
  754.         D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
  755.         DRWSTRING 1, 15, 8, D$, 10, 32
  756.         A$ = INKEY$
  757.     WEND
  758.     RET$ = A$
  759.     IF RET$ = "q" THEN
  760.         RET$ = "Q"
  761.     END IF
  762.     IF RET$ = "s" THEN
  763.         RET$ = "S"
  764.     END IF
  765.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  766.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  767.         FILLSCREEN 0
  768.         SETVIEW 0, 0, GETMAXX, GETMAXY
  769.         EXIT SUB
  770.     END IF
  771.  
  772.     '*************************************************************************
  773.     '* SHOW MOUSEHIDE
  774.     '*************************************************************************
  775.     MOUSEHIDE
  776.     SETVIEW 0, 0, GETMAXX, 31
  777.     FILLVIEW 0
  778.     SETVIEW 0, 0, GETMAXX, GETMAXY
  779.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  780.     A$ = "MOUSEHIDE ()"
  781.     DRWSTRING 1, 7, 0, A$, 10, 16
  782.     SETVIEW 0, 32, GETMAXX, GETMAXY
  783.     A$ = ""
  784.     SOUND 700, .75
  785.     WHILE A$ = ""
  786.         MOUSESTATUS X, Y, MButs
  787.         IF MButs AND 1 THEN
  788.             LB = 1
  789.         ELSE
  790.             LB = 0
  791.         END IF
  792.         IF MButs AND 2 THEN
  793.             RB = 1
  794.         ELSE
  795.             RB = 0
  796.         END IF
  797.         IF MButs AND 4 THEN
  798.             CB = 1
  799.         ELSE
  800.             CB = 0
  801.         END IF
  802.         D$ = "X=" + STR$(X)
  803.         L = LEN(D$)
  804.         IF L < 10 THEN
  805.             D$ = D$ + STRING$(8 - L, 32)
  806.         END IF
  807.         D$ = D$ + "Y=" + STR$(Y)
  808.         L = LEN(D$)
  809.         IF L < 20 THEN
  810.             D$ = D$ + STRING$(16 - L, 32)
  811.         END IF
  812.         D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
  813.         DRWSTRING 1, 15, 8, D$, 10, 32
  814.         A$ = INKEY$
  815.     WEND
  816.     MOUSESHOW
  817.     RET$ = A$
  818.     IF RET$ = "q" THEN
  819.         RET$ = "Q"
  820.     END IF
  821.     IF RET$ = "s" THEN
  822.         RET$ = "S"
  823.     END IF
  824.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  825.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  826.         FILLSCREEN 0
  827.         SETVIEW 0, 0, GETMAXX, GETMAXY
  828.         EXIT SUB
  829.     END IF
  830.  
  831.     '*************************************************************************
  832.     '* SHOW MOUSERANGESET
  833.     '*************************************************************************
  834.     MOUSEHIDE
  835.     SETVIEW 0, 0, GETMAXX, 48
  836.     FILLVIEW 0
  837.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  838.     A$ = "MOUSERANGESET (X1,Y1,X2,Y2)"
  839.     DRWSTRING 1, 7, 0, A$, 10, 16
  840.     SETVIEW 0, 0, GETMAXX, GETMAXY
  841.     SPCNG = (GETMAXY - 32) \ 3
  842.     X1 = SPCNG
  843.     Y1 = 32 + SPCNG
  844.     X2 = GETMAXX - SPCNG
  845.     Y2 = GETMAXY - SPCNG
  846.     DRWBOX 1, 15, X1, Y1, X2, Y2
  847.     MOUSESHOW
  848.     MOUSERANGESET X1, Y1, X2, Y2
  849.     GETKEY RET$
  850.     MOUSERANGESET 0, 0, GETMAXX, GETMAXY
  851.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  852.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  853.         FILLSCREEN 0
  854.         SETVIEW 0, 0, GETMAXX, GETMAXY
  855.         EXIT SUB
  856.     END IF
  857.  
  858.  
  859.     '*************************************************************************
  860.     '* SHOW MOUSECURSORSET USE THE MAGNIFIER
  861.     '*************************************************************************
  862.     SETVIEW 0, 0, GETMAXX, 31
  863.     FILLVIEW 0
  864.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  865.     A$ = "MOUSECURSORSET (XHotSpot,YHotSpot,MouseCursor$)"
  866.     DRWSTRING 1, 7, 0, A$, 10, 16
  867.     SETVIEW 0, 32, GETMAXX, GETMAXY
  868.     MOUSECURSORSET MAGMOUSECURSOR
  869.     GETKEY RET$
  870.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  871.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  872.         FILLSCREEN 0
  873.         SETVIEW 0, 0, GETMAXX, GETMAXY
  874.         EXIT SUB
  875.     END IF
  876.  
  877.     '*************************************************************************
  878.     '* SHOW MOUSECURSORSET USE THE BIG ARROW
  879.     '*************************************************************************
  880.     SETVIEW 0, 32, GETMAXX, GETMAXY
  881.     MOUSECURSORSET BIGMOUSECURSOR
  882.     GETKEY RET$
  883.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  884.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  885.         FILLSCREEN 0
  886.         SETVIEW 0, 0, GETMAXX, GETMAXY
  887.         EXIT SUB
  888.     END IF
  889.  
  890.     '*************************************************************************
  891.     '* SHOW MOUSECURSORSET USE THE STOPWATCH
  892.     '*************************************************************************
  893.     MOUSECURSORSET STWMOUSECURSOR
  894.     GETKEY RET$
  895.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  896.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  897.         FILLSCREEN 0
  898.         SETVIEW 0, 0, GETMAXX, GETMAXY
  899.         EXIT SUB
  900.     END IF
  901.  
  902.     '*************************************************************************
  903.     '* SHOW MOUSECURSORDEFAULT
  904.     '*************************************************************************
  905.     MOUSEHIDE
  906.     SETVIEW 0, 0, GETMAXX, 31
  907.     FILLVIEW 0
  908.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  909.     A$ = "MOUSECURSORDEFAULT ()"
  910.     DRWSTRING 1, 7, 0, A$, 10, 16
  911.     MOUSESHOW
  912.     SETVIEW 0, 32, GETMAXX, GETMAXY
  913.     MOUSECURSORDEFAULT
  914.     GETKEY RET$
  915.     MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  916.     FILLSCREEN 0
  917.     SETVIEW 0, 0, GETMAXX, GETMAXY
  918.  
  919.     END SUB
  920.  
  921.     SUB DOPCX (RET$)
  922.     DEFINT A-Z
  923.     REM $DYNAMIC
  924.  
  925.     '*************************************************************************
  926.     '* SET UP THE TITLE
  927.     '*************************************************************************
  928.     TITLE$ = "DEMO 8: PCX functions"
  929.  
  930.     '*************************************************************************
  931.     '* SHOW PCX GET INFO
  932.     '*************************************************************************
  933.     SETVIEW 0, 0, GETMAXX, GETMAXY
  934.     FILLSCREEN 0
  935.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  936.  
  937. LP:
  938.  
  939.     A$ = "Please provide the name and full path (if not in the current drive/directory)"
  940.     B$ = "of a PCX file you would like to see..."
  941.     C$ = "Filename:"
  942.     DRWSTRING 1, 7, 0, A$, 10, 64
  943.     DRWSTRING 1, 7, 0, B$, 10, 80
  944.     DRWSTRING 1, 7, 0, C$, 10, 96
  945.  
  946.     FILENAME$ = "_"
  947.     LENGTH = 0
  948.     EXT = 0
  949.  
  950.     WHILE EXT = 0
  951.         DRWSTRING 1, 15, 0, FILENAME$, 82, 96
  952.         A$ = ""
  953.         WHILE LEN(A$) < 1 OR LEN(A$) > 1
  954.             A$ = INKEY$
  955.         WEND
  956.         A = ASC(A$)
  957.         IF A > 31 AND A < 128 THEN
  958.             FILENAME$ = LEFT$(FILENAME$, LENGTH) + A$ + "_"
  959.             LENGTH = LENGTH + 1
  960.         ELSE
  961.             IF A = 8 AND LENGTH > 0 THEN
  962.                 DRWSTRING 1, 15, 0, STRING$(LENGTH + 1, 32), 82, 96
  963.                 LENGTH = LENGTH - 1
  964.                 FILENAME$ = LEFT$(FILENAME$, LENGTH) + "_"
  965.             ELSEIF A = 13 THEN
  966.                 EXT = 1
  967.             END IF
  968.         END IF
  969.     WEND
  970.     FILENAME$ = LEFT$(FILENAME$, LENGTH)
  971.     IF LEN(FILENAME$) < 1 THEN
  972.         EXIT SUB '* OOPS! NO NAME GIVEN SO LET'S JUST BAIL OUT!
  973.     END IF
  974.     SHOWPCX RET$, FILENAME$
  975.     IF RET$ = "S" OR RET$ = "Q" THEN
  976.         FILLSCREEN 0
  977.         EXIT SUB
  978.     END IF
  979.  
  980.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  981.     A$ = "Would you like to see another (Y/N) ?"
  982.     DRWSTRING 1, 7, 0, A$, 10, 64
  983.     EXT = 0
  984.     SOUND 700, .75
  985.     WHILE EXT = 0
  986.         A$ = ""
  987.         WHILE A$ = ""
  988.             A$ = INKEY$
  989.         WEND
  990.         IF A$ = "Y" OR A$ = "y" THEN
  991.             GOTO LP
  992.         ELSEIF A$ = "N" OR A$ = "n" THEN
  993.             EXT = 1
  994.         ELSE
  995.             SOUND 100, 5
  996.         END IF
  997.     WEND
  998.     FILLSCREEN 0
  999.  
  1000.     END SUB
  1001.  
  1002.     SUB SHOWHOUSE
  1003.     DEFINT A-Z
  1004.     REM $DYNAMIC
  1005.  
  1006.     SHARED OPLOTARRY() AS P2DType
  1007.     SHARED PLOTARRY() AS P2DType
  1008.  
  1009.     '*************************************************************************
  1010.     '* THIS ROUTINE IS CALLED BY DO3D
  1011.     '*************************************************************************
  1012.  
  1013.     '*************************************************************************
  1014.     '* ERASE THE OLD HOUSE
  1015.     '*************************************************************************
  1016.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(11).X, OPLOTARRY(11).Y
  1017.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(12).X, OPLOTARRY(12).Y
  1018.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(13).X, OPLOTARRY(13).Y
  1019.     FOR I = 0 TO 2
  1020.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 1).X, OPLOTARRY(I + 1).Y
  1021.         DRWLINE 1, 0, OPLOTARRY(I + 4).X, OPLOTARRY(I + 4).Y, OPLOTARRY(I + 4 + 1).X, OPLOTARRY(I + 4 + 1).Y
  1022.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 4).X, OPLOTARRY(I + 4).Y
  1023.     NEXT I
  1024.     DRWLINE 1, 0, OPLOTARRY(3).X, OPLOTARRY(3).Y, OPLOTARRY(7).X, OPLOTARRY(7).Y
  1025.     DRWLINE 1, 0, OPLOTARRY(0).X, OPLOTARRY(0).Y, OPLOTARRY(3).X, OPLOTARRY(3).Y
  1026.     DRWLINE 1, 0, OPLOTARRY(4).X, OPLOTARRY(4).Y, OPLOTARRY(7).X, OPLOTARRY(7).Y
  1027.     DRWLINE 1, 0, OPLOTARRY(3).X, OPLOTARRY(3).Y, OPLOTARRY(8).X, OPLOTARRY(8).Y
  1028.     DRWLINE 1, 0, OPLOTARRY(8).X, OPLOTARRY(8).Y, OPLOTARRY(2).X, OPLOTARRY(2).Y
  1029.     DRWLINE 1, 0, OPLOTARRY(7).X, OPLOTARRY(7).Y, OPLOTARRY(9).X, OPLOTARRY(9).Y
  1030.     DRWLINE 1, 0, OPLOTARRY(9).X, OPLOTARRY(9).Y, OPLOTARRY(6).X, OPLOTARRY(6).Y
  1031.     DRWLINE 1, 0, OPLOTARRY(8).X, OPLOTARRY(8).Y, OPLOTARRY(9).X, OPLOTARRY(9).Y
  1032.  
  1033.     '*************************************************************************
  1034.     '* DRAW THE NEW HOUSE
  1035.     '*************************************************************************
  1036.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(11).X, PLOTARRY(11).Y
  1037.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(12).X, PLOTARRY(12).Y
  1038.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(13).X, PLOTARRY(13).Y
  1039.     FOR I = 0 TO 2
  1040.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 1).X, PLOTARRY(I + 1).Y
  1041.         DRWLINE 1, 10, PLOTARRY(I + 4).X, PLOTARRY(I + 4).Y, PLOTARRY(I + 4 + 1).X, PLOTARRY(I + 4 + 1).Y
  1042.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 4).X, PLOTARRY(I + 4).Y
  1043.     NEXT I
  1044.     DRWLINE 1, 10, PLOTARRY(3).X, PLOTARRY(3).Y, PLOTARRY(7).X, PLOTARRY(7).Y
  1045.     DRWLINE 1, 10, PLOTARRY(0).X, PLOTARRY(0).Y, PLOTARRY(3).X, PLOTARRY(3).Y
  1046.     DRWLINE 1, 10, PLOTARRY(4).X, PLOTARRY(4).Y, PLOTARRY(7).X, PLOTARRY(7).Y
  1047.     DRWLINE 1, 10, PLOTARRY(3).X, PLOTARRY(3).Y, PLOTARRY(8).X, PLOTARRY(8).Y
  1048.     DRWLINE 1, 10, PLOTARRY(8).X, PLOTARRY(8).Y, PLOTARRY(2).X, PLOTARRY(2).Y
  1049.     DRWLINE 1, 10, PLOTARRY(7).X, PLOTARRY(7).Y, PLOTARRY(9).X, PLOTARRY(9).Y
  1050.     DRWLINE 1, 10, PLOTARRY(9).X, PLOTARRY(9).Y, PLOTARRY(6).X, PLOTARRY(6).Y
  1051.     DRWLINE 1, 10, PLOTARRY(8).X, PLOTARRY(8).Y, PLOTARRY(9).X, PLOTARRY(9).Y
  1052.  
  1053.     '*************************************************************************
  1054.     '* SAVE THE OLD POINTS
  1055.     '*************************************************************************
  1056.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
  1057.  
  1058.     END SUB
  1059.  
  1060.     SUB SHOWPCX (RET$, FILENAME$)
  1061.     DEFINT A-Z
  1062.     REM $DYNAMIC
  1063.  
  1064.     '*************************************************************************
  1065.     '* THIS ROUTINE IS CALLED BY DOPCX
  1066.     '*************************************************************************
  1067.     TITLE$ = "DEMO 8: PCX functions"
  1068.  
  1069.     '*************************************************************************
  1070.     '* SHOW PCX GET INFO
  1071.     '*************************************************************************
  1072.     FILLSCREEN 0
  1073.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  1074.     A$ = "PCXGETINFO(FileName$,PCXXSize,PCXYSize,NumColors,Palette$)"
  1075.     DRWSTRING 1, 7, 0, A$, 10, 16
  1076.     PCXFILENAME$ = FILENAME$
  1077.     OK = PCXGETINFO(PCXFILENAME$, XSIZE, YSIZE, NUMCOL, PCXPAL)
  1078.     MIN& = (255 ^ 2) * 3
  1079.     MAX& = 0
  1080.     IF OK = 1 THEN
  1081.         '*********************************************************************
  1082.         '* WE NEED TO CHECK THE PCX COLOR PALETTE ENTRIES TO SEE IF ANY COLORS
  1083.         '* ARE GREATER THE SIX BITS IN LENGTH AS THE VGA COLOR PALETTE
  1084.         '* REGISTERS ARE ONLY SIX BITS WIDE. WE ALSO LOOK FOR THE BRIGHTEST
  1085.         '* AND DARKEST COLORS TO USE AS OUR TEXT AND BACKGROUND COLORS
  1086.         '*********************************************************************
  1087.         FIXIT = 0
  1088.         FOR A = 1 TO NUMCOL * 3 STEP 3
  1089.             R = ASC(MID$(PCXPAL, A, 1))
  1090.             G = ASC(MID$(PCXPAL, A + 1, 1))
  1091.             B = ASC(MID$(PCXPAL, A + 2, 1))
  1092.             IF R > 63 THEN
  1093.                 FIXIT = 1
  1094.             END IF
  1095.             IF G > 63 THEN
  1096.                 FIXIT = 1
  1097.             END IF
  1098.             IF B > 63 THEN
  1099.                 FIXIT = 1
  1100.             END IF
  1101.             TEST& = R ^ 2 + G ^ 2 + B ^ 2
  1102.             IF TEST& < MIN& THEN
  1103.                 '* FIND THE DARKEST COLOR FOR THE BACKGROUND
  1104.                 MIN& = TEST&
  1105.                 MINCOLOR = A / 3
  1106.             END IF
  1107.             IF TEST& > MAX& THEN
  1108.                 '* FIND THE BRIGHTEST COLOR FOR THE TEXT
  1109.                 MAX& = TEST&
  1110.                 MAXCOLOR = A / 3
  1111.             END IF
  1112.         NEXT A
  1113.         '*********************************************************************
  1114.         '* IF THE PCX USES 8 BIT COLOR THEN WE SHIFT EACH COLOR ENTRY RIGHT
  1115.         '* BY 2 BITS (THIS REDUCES IT TO 6 BITS OF COLOR)
  1116.         '*********************************************************************
  1117.         IF FIXIT = 1 THEN
  1118.             FOR A = 1 TO NUMCOL * 3
  1119.                 C = ASC(MID$(PCXPAL, A, 1))
  1120.                 MID$(PCXPAL, A, 1) = CHR$(C \ 4)
  1121.             NEXT A
  1122.         END IF
  1123.         '*********************************************************************
  1124.         '* IF THE PCX HAS A PALETTE OF 128 COLORS OR LESS THEN WE CAN USE
  1125.         '* OUR OWN COLORS FOR THE TEXT AND BACKGROUND
  1126.         '*********************************************************************
  1127.         IF NUMCOL < 128 THEN
  1128.             MID$(PCXPAL, 763, 1) = CHR$(0)  '* THIS IS THE COLOR BLACK
  1129.             MID$(PCXPAL, 764, 1) = CHR$(0)
  1130.             MID$(PCXPAL, 765, 1) = CHR$(0)
  1131.             MINCOLOR = 254
  1132.             MID$(PCXPAL, 766, 1) = CHR$(32) '* THIS IS THE COLOR MED WHITE
  1133.             MID$(PCXPAL, 767, 1) = CHR$(32)
  1134.             MID$(PCXPAL, 768, 1) = CHR$(32)
  1135.             MAXCOLOR = 255
  1136.         END IF
  1137.  
  1138.         A$ = "'" + PCXFILENAME$ + "' is identified as a v3.0 PCX file."
  1139.         DRWSTRING 1, 15, 0, A$, 10, 64
  1140.         A$ = "Dimensions are:" + STR$(XSIZE) + " pixels wide and" + STR$(YSIZE) + " pixels high"
  1141.         DRWSTRING 1, 15, 0, A$, 10, 80
  1142.         A$ = "Number of colors:" + STR$(NUMCOL)
  1143.         DRWSTRING 1, 15, 0, A$, 10, 96
  1144.  
  1145.         GETKEY RET$
  1146.         IF (RET$ = "S") OR (RET$ = "Q") THEN
  1147.             FILLSCREEN 0
  1148.             SETVIEW 0, 0, GETMAXX, GETMAXY
  1149.             EXIT SUB
  1150.         END IF
  1151.  
  1152.         '*********************************************************************
  1153.         '* SHOW PCX GET PUT
  1154.         '*********************************************************************
  1155.         PALSET PCXPAL, 0, 255
  1156.         OVERSCANSET MINCOLOR
  1157.         FILLSCREEN MINCOLOR
  1158.         DRWSTRING 1, MAXCOLOR, MINCOLOR, TITLE$, 10, 0
  1159.         A$ = "PCXPUT(Mode,X,Y,FileName$)"
  1160.         DRWSTRING 1, MAXCOLOR, MINCOLOR, A$, 10, 16
  1161.         SETVIEW 0, 32, GETMAXX, GETMAXY
  1162.         Xloc = (GETMAXX \ 2) - (XSIZE \ 2)
  1163.         Yloc = ((GETMAXY - 32) \ 2) - (YSIZE \ 2) + 32
  1164.         OK = PCXPUT(1, Xloc, Yloc, PCXFILENAME$)
  1165.         IF OK <> 1 THEN
  1166.         '*********************************************************************
  1167.         '* OOPSTHIS FILE HAS SOME PROBLEM
  1168.         '********************************************************************
  1169.             SOUND 100, 5
  1170.             A$ = "The file '" + PCXFILENAME$ + "' "
  1171.             B$ = ""
  1172.             SELECT CASE OK
  1173.                 CASE IS = 0
  1174.                     A$ = A$ + "does not exist in the specified directory"
  1175.                     B$ = " or there is some disk I/O problem."
  1176.                 CASE IS = -1
  1177.                     A$ = A$ + "is not a v 3.0 PCX file."
  1178.                 CASE IS = -2
  1179.                     A$ = A$ + "is not run length encoded."
  1180.                 CASE IS = -3
  1181.                     A$ = A$ + "has some general error."
  1182.             END SELECT
  1183.             DRWSTRING 1, MINCOLOR, MAXCOLOR, A$, 10, 64
  1184.             DRWSTRING 1, MINCOLOR, MAXCOLOR, B$, 10, 80
  1185.         END IF
  1186.     ELSE
  1187.         '*********************************************************************
  1188.         '* OOPSTHIS FILE HAS SOME PROBLEM
  1189.         '*********************************************************************
  1190.         SOUND 100, 5
  1191.         A$ = "The file '" + PCXFILENAME$ + "' "
  1192.         B$ = ""
  1193.         SELECT CASE OK
  1194.             CASE IS = 0
  1195.                 A$ = A$ + "does not exist in the specified directory"
  1196.                 B$ = " or there is some disk I/O problem."
  1197.             CASE IS = -1
  1198.                 A$ = A$ + "is not a v 3.0 PCX file."
  1199.             CASE IS = -2
  1200.                 A$ = A$ + "is not run length encoded."
  1201.             CASE IS = -3
  1202.             A$ = A$ + "has some general error."
  1203.         END SELECT
  1204.         DRWSTRING 1, 15, 0, A$, 10, 64
  1205.         DRWSTRING 1, 15, 0, B$, 10, 80
  1206.     END IF
  1207.     GETKEY RET$
  1208.     PALSET ORGPAL, 0, 255
  1209.     OVERSCANSET 0
  1210.     FILLSCREEN 0
  1211.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1212.  
  1213.     END SUB
  1214.  
  1215.     SUB SHOWSTAR
  1216.     DEFINT A-Z
  1217.     REM $DYNAMIC
  1218.  
  1219.     SHARED OPLOTARRY() AS P2DType
  1220.     SHARED PLOTARRY() AS P2DType
  1221.  
  1222.     '*************************************************************************
  1223.     '* THIS ROUTINE IS CALLED BY DO2D
  1224.     '*************************************************************************
  1225.  
  1226.     '*************************************************************************
  1227.     '* ERASE THE OLD STAR
  1228.     '*************************************************************************
  1229.     FOR I = 0 TO 7
  1230.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 1).X, OPLOTARRY(I + 1).Y
  1231.     NEXT I
  1232.  
  1233.     '*************************************************************************
  1234.     '* DRAW THE NEW STAR
  1235.     '*************************************************************************
  1236.     FOR I = 0 TO 7
  1237.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 1).X, PLOTARRY(I + 1).Y
  1238.     NEXT I
  1239.  
  1240.     '*************************************************************************
  1241.     '* SAVE THE OLD POINTS
  1242.     '*************************************************************************
  1243.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 36
  1244.  
  1245.     END SUB
  1246.